#=====================================================================
# Growth projection of peak over time
#
# From Jack Dongarra; see slide 7 of
# http://www.cs.utk.edu/~dongarra/WEB-PAGES/cscads-libtune-09/talk01-dongarra.pdf
#
# First 1 Pflop/s machine went online in 2008
#=====================================================================

peakFlops <- function (t) FLOP_FAC * PETA * 10^((t+2)/10*3)

#=====================================================================
# Routines to help display textual comparisons of two systems
#=====================================================================

catCompare <- function (tag, fmt, units, a, b) {
  cat (sprintf (sprintf ('  %s: %s vs. %s %s [ratio=%%.3g, 1/ratio=%%.3g]\n', tag, fmt, fmt, units), a, b, a/b, b/a))
}

catCompareReal <- function (tag, a, b, units) {
  cat (sprintf ('  %s: %s%s vs. %s%s [ratio=%.3g, 1/ratio=%.3g]\n'
                , tag
                , genSIPrefix (a, function (x) genSigFigLabels (x, 3)), units
                , genSIPrefix (b, function (x) genSigFigLabels (x, 3)), units
                , a/b, b/a))
}

catCompareInt <- function (tag, a, b, units) {
  cat (sprintf ('  %s: %s vs. %s %s [ratio=%.3g, 1/ratio=%.3g]\n'
                , tag
                , genSIPrefix_int (a)
                , genSIPrefix_int (b), units
                , a/b, b/a))
}

catBlank <- function () {
  cat (sprintf ('\n'))
}

# Compare the basic configuration of two systems
compareSystems <- function (A, B, n, y) {
  cat (sprintf ('\n=== %s v. %s ===\n\n', getDesc (A), getDesc (B)))
  catCompareReal ('Peak', getPeak (A) (y), getPeak (B) (y), 'F/s')
  catCompareInt ('No. sockets', getSockets (A) (y), getSockets (B) (y), '')
  catCompareInt ('No. cores', getCores (A) (y), getCores (B) (y), '')
  catCompareReal ('Bisection bandwidth', WORD * getBisectionBW (A) (y), WORD * getBisectionBW (B) (y), 'B/s')
  catCompareReal ('Link bandwidth', WORD * getLinkBW (A) (y), WORD * getLinkBW (B) (y), 'B/s')

  catBlank ()

  catCompareReal ('Socket peak', getSocketPeak (A) (y), getSocketPeak (B) (y), 'F/s')
  catCompareReal ('Socket memory bandwidth', WORD * getSocketBW (A) (y), WORD * getSocketBW (B) (y), 'B/s')
  catCompareInt ('Socket cores', getSocketCores (A) (y), getSocketCores (B) (y), '')
  catCompareReal ('Socket core peak', getSocketCorePeak (A) (y), getSocketCorePeak (B) (y), 'F/s')
  catCompareReal ('Socket Z (fast memory or cache)', WORD * getSocketZ (A) (y), WORD * getSocketZ (B) (y), 'B')
  catCompareReal ('Socket L (line or memory transaction size)', WORD * getSocketL (A) (y), WORD * getSocketL (B) (y), 'B')

  catBlank ()
  
  catCompareReal ('T_intra', T_intra__FFT3D (A, n, y), T_intra__FFT3D (B, n, y), 'sec')
  catCompareReal ('T_inter', T_inter__FFT3D (A, n, y), T_inter__FFT3D (B, n, y), 'sec')

  catBlank ()
  
  catCompareReal ('T_overlap', T_overlap__FFT3D (A, n, y), T_overlap__FFT3D (B, n, y), 'sec')
  catCompareReal ('T_total', T__FFT3D (A, n, y), T__FFT3D (B, n, y), 'sec')
}

#=====================================================================
# Routine to help match two systems in performance
#
# Peak_B <- matchPeak (T, Proc_A, Peak_A, Proc_B, n, y)
#
# Given a system based on processor 'Proc_A' with system peak
# 'Peak_A', returns the peak 'Peak_B' of a system based on 'Proc_B'
# such that system A and B will in year 'y' have nearly identical
# execution time, as measured by 'T(*, n, y)', for a problem of size
# 'n'.
#=====================================================================

matchPeak <- function (T, Proc_A, Peak_A, Proc_B, n, y) {
  # f(x): Returns the difference in time between a system based on
  # processor B with x*EXA flop/s peak relative to System_A.
  f <- function (x) {
    T (newSysPeak (Proc_B, x*EXA), n, y) -
      T (newSysPeak (Proc_A, Peak_A), n, y)
  }
  
  # Best guess at interval containing the solution
  interval <- c (1e-3, 1000) * Peak_A / EXA

  # Run root finder on f
  Root <- uniroot (f, interval)

  # Return System B's peak
  return (Root$root * EXA)
}

#=====================================================================
# Routine to compute an appropriate problem size at some point in the
# future.
#
# Let
#
#    T := Execution time measure
#   S1 := system that solves a problem of size n1 in year y1 in time t
#   S2 := evolved system in year y2
#
# This routine returns the size n2 of problem that can also be solved
# in time t in year y2.
#=====================================================================

calcNewProblemSize <- function (T, S1, n1, y1, S2, y2) {
  f <- function (n2) { T (S2, n2, y2) - T (S1, n1, y1) }
  interval <- c (1e-3, 1e3) * n1
  Root <- uniroot (f, interval)
  return (ceiling (Root$root))
}

#=====================================================================
# Determines a suitable problem size to use on a future system
#=====================================================================

# Build a default baseline system for problem scaling projections
DEF_Sys_baseline <- newSysPeak (GPU_base, peakFlops (0))

scaleProblem <- function (T, Proc, Y, S0=DEF_Sys_baseline, n0=4096, y0=0) {
  # For each year y in Y
  sapply (Y, function (y) {
    # Build the year y system
    S <- newSysPeak (Proc, peakFlops (y))

    # Determine the year y problem size
    n <- calcNewProblemSize (T, S0, n0, y0, S, y)

    return (n)
  })
}

#=====================================================================
# Generates a name tagged by the preceding configuration parameters
#=====================================================================
genRunTag <- function (s)
  sprintf ("%s--%s--%s", s,
           if (USE_NET_TORUS3D) "net_3dtorus"
           else "net_lowerbound",
           if (USE_LOCAL_EXACT) "mem_exact"
           else "mem_asymptotic")

genRunTagPDF <- function (s)
  sprintf ("%s.pdf", genRunTag (s))

#=====================================================================
# Generate a descriptive string for the given system
#=====================================================================
genSysDesc <- function (S, tag, y) {
  desc <- sprintf ("%s sockets\nPeak = %sF/s\nBisection = %sB/s"
                   , genSIPrefix_int (getSockets (S) (y))
                   , genSIPrefixValue (getPeak (S) (y), 3)
                   , genSIPrefixValue (getBisectionBW (S) (y), 3)
                   )
  return (if (tag == "") desc else paste (tag, "\n", desc))
}

#=====================================================================
# Create a ggplot figure that compares two systems, 'A' and 'B', on a
# problem of size 'n' in year 'y'.
#=====================================================================
createSysFrame <- function (A, n, y, tag=NULL) {
  desc_a <- genSysDesc (A, if (is.null (tag)) getDesc (A) else tag, y)
  t_inter_A <- T_inter__FFT3D (A, n, y)
  t_intra_A <- T_intra__FFT3D (A, n, y)
  
  data.frame (Desc=c (desc_a, desc_a)
              , Comm=c ("Network", "Memory")
              , Time=c (t_inter_A, t_intra_A)
              , LabelPos=c (t_inter_A/2, t_inter_A + (t_intra_A/2)))
}

qplotSystems <- function (A, B, n, y, narrow=TRUE, legend.bottom=TRUE) {
  if (narrow)
    setDevNarrow ()
  
  Data <- rbind (createSysFrame (A, n, y)
                 , createSysFrame (B, n, y))
  Data$Comm <- factor (Data$Comm, c ("Network", "Memory"))

  Q <- qplot (Desc, Time, data=Data, geom="bar", stat="identity", fill=Comm) +
    geom_text (aes (y=LabelPos, label=round (Time, 3))) +
    scale_x_discrete (name="") +
    scale_y_continuous (name="Time (sec)") +
    scale_fill_discrete (name="Communication", breaks=rev (levels (Data$Comm))) +
    opts (title=sprintf ("Year=%d: n=%d", Y0+y, n))

  if (legend.bottom)
    Q <- Q + opts (legend.position="bottom", legend.align="horizontal")

  Q
}

# eof
